home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 21 / Cream of the Crop 21 (Terry Blount) (October 1996).iso / os2 / freetype.zip / tttables.pas < prev    next >
Pascal/Delphi Source File  |  1996-09-07  |  10KB  |  494 lines
  1. Unit TTTables;
  2.  
  3. interface
  4.  
  5. uses TTTypes, TTVars, TTCalc;
  6.  
  7. type
  8.   (* "loca" : table of glyph index *)
  9.   TLoca = Record
  10.         Size  : word;
  11.         Table : PStorage;
  12.       end;
  13.  
  14.   TLocas = array[0..1000] of TLoca;
  15.  
  16.  
  17. var
  18.   Table_Dir         : TTableDir;
  19.   Table_Dir_Entries  : PTableDirEntries;
  20.   Num_TDE         : int;
  21.  
  22.   MaxProfile         : TMaxProfile;
  23.  
  24.   Font_Header         : ^THeader;
  25.   Glyph_Locations    : ^TLoca;
  26.   Glyphs         : ^TGlyphs;
  27.  
  28.   Num_Glyphs         : int;    (* Number of glyphs in current font file   *)
  29.  
  30.  
  31. function   Open_TrueType_File( AName : String ) : boolean;
  32. procedure  Close_TrueType_File;
  33.  
  34. function Load_TrueType_Tables : boolean;
  35.  
  36. function LookUp_TrueType_Table( ATag : string ) : int;
  37.  
  38. function Load_TrueType_Header : boolean;
  39.  
  40. function Load_TrueType_CVT : boolean;
  41.  
  42. function Load_TrueType_Locations : Boolean;
  43.  
  44. function Load_TrueType_MaxProfile : boolean;
  45.  
  46. function Load_TrueType_Glyphs : integer;
  47.  
  48. implementation
  49.  
  50. uses TTFile;
  51.  
  52. (*************************)
  53. (*  Load_TrueType_Tables *)
  54. (*************************)
  55.  
  56. function Load_TrueType_Tables : Boolean;
  57. var
  58.   T : LongInt;
  59.   L : LongInt;
  60. begin
  61.   Load_TrueType_Tables := False;
  62.  
  63.   if not Read_At_Font_File( 0, Table_Dir, sizeof(Table_Dir) ) then exit;
  64.  
  65.   Do32( Fixed( Table_Dir.Version ) );
  66.   Do16( Table_Dir.NumTables );
  67.  
  68. {$IFDEF DEBUG}
  69.   Writeln('Version de rĂ©pertoire : ',TableDir.version/$10000);
  70.   Writeln('Nombre de Tables     : ',TableDir.numTables);
  71.  
  72. {$ENDIF}
  73.  
  74.   Num_TDE := Table_Dir.NumTables;
  75.  
  76.   L := sizeof(TTableDirEntry) * Num_TDE;
  77.  
  78.   if not Alloc( L, Pointer(Table_Dir_Entries) ) or
  79.      not Read_Font_File( Table_Dir_Entries^, L ) then exit;
  80.  
  81.   for t:=0 to Num_TDE-1 do with Table_Dir_Entries^[t] do
  82.     begin
  83.      CheckSum:=0;
  84.      Do32( Offset );
  85.      Do32( Length );
  86.    end;
  87.  
  88.   Load_TrueType_Tables := True;
  89. end;
  90.  
  91. (***************************)
  92. (*  LookUp_TrueType_Table  *)
  93. (***************************)
  94.  
  95. function LookUp_TrueType_Table( ATag : string ) : int;
  96. var
  97.   TAG : String[4];
  98.   i   : int;
  99. begin
  100.   TAG[0] := #4;
  101.   LookUp_TrueType_Table := -1;
  102.  
  103.   if Table_Dir_Entries = nil then exit;
  104.  
  105.   for i := 0 to Num_TDE-1 do
  106.     begin
  107.  
  108.       move( Table_Dir_Entries^[i].Tag, Tag[1], 4 );
  109.  
  110.       if Tag = ATag then
  111.     begin
  112.       LookUp_TrueType_Table := i;
  113.       exit;
  114.     end
  115.  
  116.     end
  117. end;
  118.  
  119. (**************************)
  120. (*  Load_TrueType_Header  *)
  121. (**************************)
  122.  
  123. function  Load_TrueType_Header : Boolean;
  124. var
  125.   i : int;
  126. begin
  127.   Load_TrueType_Header := False;
  128.  
  129.   i := LookUp_TrueType_Table('head');
  130.   if i <= 0 then exit;
  131.  
  132.   if not Alloc( sizeof(THeader), Pointer(Font_Header) ) or
  133.  
  134.      not Read_At_FOnt_File( Table_Dir_Entries^[i].Offset,
  135.                 Font_Header^, sizeof(THeader) )
  136.       then exit;
  137.  
  138.   with Font_Header^ do
  139.     begin
  140.  
  141.       Do16( word(IndexToLocFormat) );
  142.       Do16( UnitsPerEM );
  143.   {$IFDEF DEBUG}
  144.       Writeln('Taille du Cadratin : ',UnitsPerEM );
  145.       Writeln('IndexToLocFormat   : ',IndexToLocFormat );
  146.       Writeln('Nombre de glyphes  : ',numGlyphs );
  147.   {$ENDIF}
  148.     end;
  149.  
  150.   Load_TrueType_Header := True;
  151. end;
  152.  
  153. (***************************)
  154. (* Load_TrueType_Locations *)
  155. (***************************)
  156.  
  157. function Load_TrueType_Locations : Boolean;
  158. var
  159.   i          : int;
  160.   sz          : longint;
  161.   t          : int;
  162.   LongOffsets : int;
  163.   locs          : PStorage;
  164.   locs2       : PShortArray;
  165.   Mrk          : TMarkRecord;
  166.  
  167. begin
  168.  
  169.   Load_TrueType_Locations := False;
  170.   LongOffsets          := 0;
  171.  
  172.   if Font_Header = nil then
  173.     if not Load_TrueType_Header then exit;
  174.  
  175.   LongOffsets :=  Font_Header^.IndexToLocFormat;
  176.  
  177.   (* default offsets format is short *)
  178.  
  179.   T := LookUp_TrueType_Table('loca');
  180.   if T < 0 then exit;
  181.  
  182.   if not Alloc( sizeof(TLoca), Pointer(Glyph_Locations) ) then exit;
  183.  
  184.   if LongOffsets <> 0 then
  185.     begin
  186.       sz := Table_Dir_Entries^[T].Length shr 2;
  187.       Glyph_Locations^.Size := sz;
  188.  
  189.       {$IFDEF DEBUG}
  190.       Writeln('Glyph Slots # ( 32-bits offsets ) : ', sz );
  191.       {$ENDIF}
  192.  
  193.       if not Alloc( 4*Sz, Pointer( Locs ) ) then exit;
  194.  
  195.       Glyph_Locations^.Table := locs;
  196.  
  197.       if not Read_At_Font_File( Table_Dir_Entries^[T].Offset,
  198.                 Locs^[0], Sz*4 ) then exit;
  199.  
  200.       Do32s( locs^[0], sz );
  201.     end
  202.   else
  203.     begin
  204.       sz := Table_Dir_Entries^[T].Length shr 1;
  205.       Glyph_Locations^.Size := Sz;
  206.  
  207.       {$IFDEF DEBUG}
  208.       Writeln('Glyph Slots # ( 16-bits offsets ) : ', Sz );
  209.       {$ENDIF}
  210.  
  211.       if not Alloc( 4*Sz, Pointer(locs) ) then exit;
  212.       Mark( Mrk );
  213.       if not Alloc( 2*Sz, Pointer(locs2)  ) then exit;
  214.  
  215.       Glyph_Locations^.Table := locs;
  216.  
  217.       if not Read_At_Font_File( Table_Dir_Entries^[T].Offset,
  218.                 locs2^[0], 2*sz ) then exit;
  219.  
  220.       Do16s( locs2^[0], sz );
  221.       for i := 0 to sz-1 do Locs^[i] := 2*longint( locs2^[i] );
  222.  
  223.       if not Release( Mrk ) then exit;
  224.     end;
  225.  
  226.   Load_TrueType_Locations := True;
  227. end;
  228.  
  229.  
  230.  
  231. function Load_TrueType_CVT : boolean;
  232. var
  233.   m : int;
  234. begin
  235.   Load_TrueType_CVT := False;
  236.   m := LookUp_TrueType_Table('cvt ');
  237.   if m<0 then exit;
  238.  
  239.   with Table_Dir_Entries^[m] do
  240.    begin
  241.      GetMem( CVT, Length );
  242.      CvtSize := Length div sizeof(Short);
  243.      if not Read_At_Font_File( Offset, CVT^, Length ) then exit;
  244.      Do16s( CVT^, CvtSize );
  245.    end;
  246.  
  247.   Load_TrueType_CVT := True;
  248. end;
  249.  
  250. (******************************)
  251. (*  Load_TrueType_MaxProfile  *)
  252. (******************************)
  253.  
  254. function Load_TrueType_MaxProfile : boolean;
  255. var
  256.   m : int;
  257. begin
  258.  
  259.   Load_TrueType_MaxProfile := False;
  260.  
  261.   m:=LookUp_TrueType_Table('maxp');
  262.   if m<0 then exit;
  263.  
  264.   if not Read_At_Font_File( Table_Dir_Entries^[m].Offset,
  265.                 MaxProfile, sizeof(MaxProfile) ) then exit;
  266.  
  267.   with MaxProfile do
  268.    begin
  269.     Do32( Version );
  270.     Do16( numGlyphs );
  271.     Do16( maxPoints );
  272.     Do16( maxContours );
  273.     Do16( maxCompositePoints );
  274.     Do16( maxCompositeContours );
  275.     Do16( maxZones );
  276.     Do16( maxTwilightPoints );
  277.     Do16( maxStorage );
  278.     Do16( maxFunctionDefs );
  279.     Do16( maxInstructionDefs );
  280.     Do16( maxStackElements );
  281.     Do16( maxSizeOfInstructions );
  282.     Do16( maxComponentElements );
  283.     Do16( maxCOmponentDepth );
  284.    end;
  285.  
  286.   Num_Glyphs           := MaxProfile.NumGlyphs;
  287.   Load_TrueType_MaxProfile := True;
  288. end;
  289.  
  290. (**************************)
  291. (*  Load_TrueType_Glyphs  *)
  292. (**************************)
  293.  
  294. function Load_TrueType_Glyphs : integer;
  295. var
  296.   sz, szc, szp : int;
  297.   i, j, k, cnt : int;
  298.   b, c           : byte;
  299.  
  300.   offset : longint;
  301.   locs     : PStorage;
  302.  
  303.   GL  : TGlyph;
  304.   Con : PGlyphContours;
  305.   Pts : PPoints;
  306.  
  307. label
  308.   Suite,
  309.   Fin;
  310.  
  311. begin
  312.   Load_TrueType_Glyphs:=0;
  313.  
  314.   i:=LookUp_TrueType_Table('glyf');
  315.   if i<0 then exit;
  316.  
  317.   Offset:=Table_Dir_Entries^[i].Offset;
  318.  
  319.   if Glyph_Locations=NIL then
  320.    if not Load_TrueType_Locations then exit;
  321.  
  322.   locs := Glyph_Locations^.Table;
  323.   sz   := Glyph_Locations^.Size;
  324.  
  325.   if not Alloc( Sizeof( TGlyph)*Sz, Pointer(Glyphs) ) then exit;
  326.  
  327.   j:=0;
  328.  
  329.   for i:=0 to Num_Glyphs-1 do
  330.  
  331.    begin
  332.  
  333.     if not Read_At_Font_File( Offset+locs^[i],
  334.                   GL, 5*sizeof(Integer) ) then goto Suite;
  335.     (* INVALID OFFSET ??? *)
  336.  
  337.     Do16( Word( Gl.numberOfContours ) );
  338.     Do16( Word( Gl.xMin ) ); Do16( Word( Gl.yMin ) );
  339.     Do16( Word( Gl.xMax ) ); Do16( Word( Gl.yMax ) );
  340.  
  341.     Write('.');
  342.  
  343.     {$IFDEF DEBUG}
  344.     Writeln(' Nombre de Contours : ',Gl.numberOfContours );
  345.     Writeln(' xMin : ',Gl.xMin:4,'  xMax : ',Gl.xMax);
  346.     Writeln(' yMin : ',Gl.yMin:4,'  yMax : ',Gl.yMax);
  347.     Writeln('-');
  348.     {$ENDIF}
  349.  
  350.     szc:=Gl.numberOfContours;
  351.     if szc<0 then Goto Suite;
  352.     if szc>MaxProfile.maxContours then
  353.      begin
  354. {$IFDEF DEBUG}
  355.       Writeln('Erreur: Glyph ',i,' de ',szc,' contours > ',
  356.            maxProfile.maxContours );
  357.       readkey;
  358. {$ENDIF}
  359.       goto Suite;
  360.      end;
  361.  
  362.     GetMem( Con, Sizeof(TGlyphContour)*szc );
  363.     If Con=NIL then Goto Fin;
  364.  
  365.     Gl.Contours:=Con;
  366.     Szp:=0;
  367.     For k:=0 to szc-1 do
  368.      begin
  369.  
  370.       {$IFDEF DEBUG}
  371.       Write( szp,' ');
  372.       {$ENDIF}
  373.  
  374.       Con^[k].Start:=Szp;
  375.